00100	
00200	
00300	(DEFPROP PARMOD1 
00400	 (LAMBDA(C D)
00500	  (PROG (PF YC YD Z Z1 Z2 X Y Y1 Y2 PAR TS)
00700		(SETQ YC (CDR C))
00800	   PAR1 (SETQ YD (CDR D))
01600		(SETQ X (CAR YC))
01700		(COND ((NEG X) (RETURN PAR))
01800		      ((ORDERP (CAR X) EQUAL) (GO PAR2))
01900		      ((NOT (EQ (CAR X) EQUAL)) (RETURN PAR)))
02000	   PAR3 PAR3A
02100		(COND ((NEG (CAR YD)) (SETQ Z2 (CDAR YD))) (T (SETQ Z2 (CAR YD))))
02200		(SETQ Y1 (CDDR X))
02300		(SETQ Y2 (CADR X))
02400	PAR3B(COND ((VAR (CAR Y1)) (GO PAR7A)))
02450	
02500		(SETQ Z (TERMS (CAAR Y1) (CDR Z2) PDEPTH))
02600		(COND ((NULL Z) (GO PAR7A)))
02700	   PAR5 (SETQ Z1 Z)
02800	   PAR4 
02850	(COND
02862	   ((CONST(CAR Y1))(COND((OR(VAR(CAAR Z1))(NOT(EQ(CAAR Y1)(CAAAR Z1))))
02868	    (GO PAR7))(T(SETQ TS (COPY Y2))(GO PAR9))))
02871	((OR(VAR(CAAR Z1))(NOT(EQ(CAAR Y1)(CAAAR Z1))))(GO PAR7)) )
02875	(SETQ Y(UNIFY(CDAR Y1)(CDAAR Z1)))
02900		(COND (Y(SETQ Y(CDR Y)) (GO PAR6)))
03000	   PAR7 (SETQ Z1 (CDR Z1))
03100		(COND (Z1 (GO PAR4)))
03200	PAR7A
03275	(COND((NULL PF)(SETQ PF T)(SETQ Y1(LIST Y2))(SETQ Y2(CADDR X))(GO PAR3B)))
03300	PAR7B	(SETQ YD (CDR YD))
03400		(COND (YD (GO PAR3A)))
03500	   PAR2 (SETQ YC (CDR YC))
03600		(COND (YC (GO PAR1)))
03700		(RETURN PAR)
03800	   PAR6 (SETQ TS (CADR (SUBS3T*  Y (LIST NIL Y2))))
03900	   PAR9 (SETQ PARRES (SUBS3TA  Y Z2 (CAR Z1) TS))
04000		(COND ((NEG (CAR YD)) (SETQ PARRES (CONS ESCAPE PARRES))))
04100		(SETQ Y (UNION  Y C D X (CAR YD)))
04200		(COND ((NULL Y) (GO PAR7)))
04500	(SETQ PAR(CONS(SET2(CAR (COND(DLIST(DEMOD Y DLIST))(T Y)))TBL)PAR))
04600		(GO PAR7))) 
04700	EXPR)
04800	
04900	(DEFPROP PUNIFY 
05000	 (LAMBDA(X Y)
05100	  (PROG (LC Z1 Z2 Z3 Z4 Z6 Z7)
05200		(SETQ LC (LIST NIL))
05300	   U3   (SETQ Z1 (CAR X))
05400		(SETQ Z2 (CAR Y))
05500		(COND ((VAR Z1) (SETQ Z3 (SEARCH Z1 (CDR LC)))) (T (SETQ Z3 Z1)))
05600		(COND ((VAR Z2) (SETQ Z4 (SEARCH Z2 (CDR LC)))) (T (SETQ Z4 Z2)))
05700		(COND ((VAR Z3)
05800		       (COND ((VAR Z4) (GO UN1))
05900			     ((CONST Z4) (GO UN3))
06000			     (T (COND ((NULL (CDR LC)) (RPLACD LC (LIST (CONS Z3 (COPY Z4)))) (GO UN2))
06100				      ((NOT (VAR Z2)) (SETQ Z4 (SUBS3T* (CDR LC) Z4))))
06200				(COND ((OCCUR Z3 (CDR Z4)) (RETURN NIL)) (T (GO UN3))))))
06300		      ((VAR Z4)(RETURN NIL))
06800		      ((AND (CONST Z3) (CONST Z4)) (COND ((NOT (EQ (CAR Z3) (CAR Z4))) (RETURN NIL)) (T (GO UN2))))
06900		      ((EQ (CAR Z3) (CAR Z4)) (SETQ Z6 (CDR (SUBS3T* (CDR LC) Z3)))
07000					      (SETQ Z7 (CDR (SUBS3T* (CDR LC) Z4)))
07100					      (SETQ X (APPEND Z6 (CDR X)))
07200					      (SETQ Y (APPEND Z7 (CDR Y)))
07300					      (GO U3))
07400		      (T (RETURN NIL)))
07500	   UN1  (SUBS2T Z3 Z4 LC)
07600	   UN2  (SETQ X (CDR X))
07700		(COND (X (SETQ Y (CDR Y)) (GO U3)))
07800		(RETURN LC)
07900	   UN3  (SUBS2T Z4 Z3 LC)
08000		(GO UN2))) 
08100	EXPR)